home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / batchut / rap101.zip / COMMON.RAP < prev    next >
Text File  |  1989-05-10  |  20KB  |  818 lines
  1. ; common.rap  v1.01  compacted version - copyright 1988 SIL - 10 May 1989
  2. #verbose=1
  3. if ($screentype == "Sharp LCD")
  4. $skip=$null
  5. else
  6. $skip=$newline*chr(13)
  7. endif
  8. $valdr=*getdr__()
  9. #help__= -1
  10. $helpfile__=
  11. $dospath__=$path
  12. proc error($message,$topic)
  13. declare $tag,$indent
  14. declare $left,$match,$right
  15. if (not ($message contains "[.!?]$"))
  16. $message=$message.
  17. endif
  18. if ($message contains "^[ \\t][ \\t]*")
  19. $indent=$match
  20. endif
  21. t:$skip*chr(7)$message\
  22. if ($topic == "")
  23. $tag=Try again.
  24. else
  25. $tag=Try again.  (Type ? for help.)
  26. endif
  27. if ((*strlen($message) + *strlen($tag)) > 72)
  28. t:
  29. t:$indent\
  30. else
  31. t:  \
  32. endif
  33. t:$tag
  34. endproc
  35. proc warning($message)
  36. if (not $message has "\\.?!$")
  37. $message=$message.
  38. endif
  39. t:$skip*chr(7)$message.
  40. kbflush()
  41. foot
  42. endproc
  43. proc mount_volume($drive,$id,$name,$topic)
  44. declare $volname,#fd,#case,#opentest,#reopen_help
  45. loop
  46. $volname=*volume($drive)
  47. exit if ($volname == $id)
  48. if (not #opentest)
  49. #opentest = 1
  50. #fd = *open("nul")
  51. close #fd
  52. if (#fd > 1 or (#fd > 0 and #help__ == -1))
  53. t:*chr(7)
  54. t:The program needs to change disks so that the $name
  55. t:disk is accessible, but it is not safe to do so because the program has
  56. t:one or more files open.
  57. t:
  58. if ($topic <> "")
  59. explain($topic)
  60. else
  61. t:   The program must terminate immediately.  Please report this
  62. t:   message to the program's author.
  63. endif
  64. foot
  65. bye
  66. endif
  67. endif
  68. if (#help__ >= 0)
  69. close #help__
  70. #help__ = -1
  71. #reopen_help = 1
  72. endif
  73. t:$skip\Put the $name disk in drive $drive.
  74. kbflush()
  75. foot:Press RETURN after you have done this.
  76. endloop
  77. if (#reopen_help)
  78. reopen_help__()
  79. endif
  80. endproc
  81. proc panic__($location,$msg)
  82. declare #paged
  83. t:*chr(7)$skip\Internal error in \*$location:
  84. t:
  85. t:    $msg
  86. t:
  87. t:The program will continue to run, but the results may not be valid.
  88. t:Copy this message exactly, so you can report it to the program's author,
  89. t:and exit as soon as possible.  You may exit immediately by typing
  90. t:Ctrl-C.
  91. kbflush()
  92. foot
  93. endproc
  94. proc kbflush()
  95. declare $junk
  96. loop while (*keypress())
  97. as $junk
  98. endloop
  99. endproc
  100. strfunc getdr__()
  101. declare $drvlist,$tmp,#case,#tmp
  102. declare $left,$match,$right
  103. if ($cmdline contains "[-/]drive=[ \\t]*")
  104. $drvlist=$right
  105. if ($drvlist contains "[ \\t]")
  106. $drvlist=$left
  107. endif
  108. return $drvlist
  109. endif
  110. if ($screentype == "Sharp LCD")
  111. if (*freesp("P") == -1)
  112. return "ABCDG"
  113. else
  114. return "ABCDGP"
  115. endif
  116. else
  117. $drvlist=AB
  118. $tmp=C
  119. loop while (*freesp($tmp) > 0)
  120. $drvlist=$drvlist$tmp
  121. #tmp = *ascii($tmp) + 1
  122. $tmp=*chr(#tmp)
  123. endloop
  124. return $drvlist
  125. endif
  126. endfunc
  127. proc explain($topic)
  128. declare #case,$line
  129. declare $left,$match,$right
  130. if (not #verbose)
  131. return
  132. else if (#help__ < 0)
  133. t:There is no help-file available to this program.
  134. foot
  135. return
  136. endif
  137. seek #help__,2
  138. loop while ($line <> "End of file.")
  139. read #help__,$line
  140. exit if (not ($line contains ":"))
  141. exit if ($left == $topic)
  142. endloop
  143. if ($line == "End of file." or $left <> $topic)
  144. t:Sorry, there is no information on <$topic> in the help file.
  145. foot
  146. return
  147. endif
  148. seek #help__,*value($right),bytes
  149. loop
  150. read #help__,$line
  151. exit if ($line == "End of file.")
  152. if (not ($line has "^\\\\"))
  153. t:$line
  154. else if ($line=="\\cls")
  155. cls
  156. else if ($line=="\\foot")
  157. foot
  158. else if ($line has "^\\\\topic[ \\t]")
  159. exit
  160. else
  161. t:$line
  162. endif
  163. endloop
  164. endproc
  165. strfunc get_filespec($query,$defpath,$defname,$defext,$topic)
  166. declare $answer,$left,$match,$right,#case,$default,$defdrive
  167. $drive=
  168. $subdir=
  169. $name=
  170. $ext=
  171. $defext=*ensure_dot($defext)
  172. if ($defpath <> "")
  173. if (not ($defpath has "[:\\\\]$"))
  174. $defpath=$defpath\\        
  175. endif
  176. endif
  177. $default=$defname$defext
  178. if ($default <> "")
  179. $query=$query [$default]
  180. endif
  181. loop
  182. $answer=*get_ans("$query (type DIR for directory):","",$topic,not +
  183. *strlen($default))
  184. if (($answer == "") and ($default == $defext))
  185. error("  Your answer must always include a filename part.",$topic)
  186. repeat
  187. else if ($answer == "")
  188. $answer=$defpath$defname$defext
  189. else if ($answer contains "^[ \\t]*dir\[ \\t]*")
  190. show_dir__($right,$defpath,$defext)
  191. repeat
  192. endif
  193. if (not ($answer has "[\\\\:]"))
  194. $answer=$defpath$answer
  195. endif
  196. if (*parse_filespec($answer,1,$topic))
  197. if ($ext == "")
  198. $ext=$defext
  199. endif
  200. return "$drive$subdir$name$ext"
  201. endif
  202. endloop
  203. endfunc
  204. strfunc get_input_file($query,$defpath,$defname,$defext,$topic)
  205. declare #case,#verbose,$filespec
  206. declare $oldname
  207. #verbose=1
  208. loop
  209. $filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
  210. #filesize=*filesize($filespec)
  211. if (#filesize < 0)
  212. error("  $filespec does not exist.",$topic)
  213. else
  214. #filesize=(#filesize+1023)/1024
  215. if (($ext == ".TMP") or ($ext == ".BAK"))
  216. t:*chr(7)An input file may not have a TMP or BAK extension.
  217. repeat if (*no("Do you want to rename the file to a different+
  218. extension","",""))
  219. $oldname=$filespec
  220. loop
  221. $ext=*get_str("New extension for $oldname","","",1,4,1)
  222. $ext=*ensure_dot($ext)
  223. $filespec=$drive$subdir$name$ext
  224. if (not *val_ext($ext,$topic))
  225. repeat
  226. else if (($ext == ".TMP") or ($ext == ".BAK"))
  227. error("  You must rename the extension to something besides TMP or BAK.",$topic)
  228. else if (not *existf($filespec))
  229. exit
  230. endif
  231. t:*chr(7)$filespec already exists.  Try a different extension.
  232. endloop
  233. xs ren $oldname $name$ext
  234. endif
  235. return $filespec
  236. endif
  237. endloop
  238. endfunc
  239. strfunc get_output_file($query,$defpath,$defname,$defext,$topic,#size)
  240. declare $filespec,#case
  241. loop
  242. $filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
  243. if (*delq($filespec) <> 4)
  244. ensure_space($drive,$subdir,#size)
  245. return $filespec
  246. endif
  247. endloop
  248. endfunc
  249. proc ensure_space($dr,$subdir,#size)
  250. declare #need
  251. declare $spare
  252. declare $delname
  253. declare $path
  254. declare $name,$ext
  255. declare $drive
  256. declare #attr
  257. if (#size < 1)
  258. return
  259. else if ($dr == "")
  260. $dr=*currdriv():
  261. else
  262. $dr=*to_upper("*mid($dr,1,1)"):
  263. endif
  264. loop
  265. #need=#size-(*freesp($dr)/1024)
  266. exit if (#need < -10)
  267. if (#need > 0)
  268. t:*chr(7)\
  269. t:
  270. t:There is not enough space for the output file on drive $dr.
  271. t:You need to reclaim at least #need\K of space before proceeding.
  272. else
  273. if (#need == 0)
  274. $spare=absolutely no space
  275. else
  276. #need = (0 - #need)
  277. $spare=only #need\K
  278. endif
  279. t:*chr(7)\
  280. t:
  281. t:Your output file will probably fit on drive $dr, but there is
  282. t:$spare to spare.  If there is a possibility that the output file
  283. t:will grow, it would be wise to make some extra space for the +
  284. output file.
  285. exit if (*no("Do you want to pause to delete some files","y",""))
  286. endif
  287. xs dir $dr$subdir /w /p
  288. get_filespec("File to delete","$dr$subdir","","","")
  289. if (*to_upper($dr) <> *to_upper($drive))
  290. error("  You must delete files on drive *to_upper($dr).","")
  291. else
  292. $delname=$dr$subdir$name$ext
  293. #attr = *deletef($delname)
  294. if (#attr == 0)
  295. t:File $delname not found.
  296. else if (#attr == 4)
  297. t:File $delname is read-only and can't be deleted.
  298. endif
  299. endif
  300. endloop
  301. endproc
  302. strfunc make_tmp_output($file,#size)
  303. declare $left,$right,$match,#case,$path
  304. declare $drive
  305. if ($file contains "\\.[^\\.\\\\]*$")
  306. $file=$left.TMP
  307. else
  308. $file=$file.TMP
  309. endif
  310. if ($file contains ":")
  311. $drive=$left
  312. else
  313. $drive=
  314. endif
  315. if (*deletef($file) == 4)
  316. panic__("make_tmp_output","Need to delete $file but it's read-only")
  317. endif
  318. ensure_space($drive,"",#size)
  319. return $file
  320. endfunc
  321. proc make_bak_file($oldname,$tmpname)
  322. declare $left,$match,$right,#case
  323. declare $bak
  324. if ($oldname contains "\\.[^\\.\\\\]*$")
  325. $bak=$left.BAK
  326. else
  327. $bak=$oldname.BAK
  328. endif
  329. if (*deletef($bak) == 4)
  330. panic__("make_bak_file","need to delete $bak but it's read-only")
  331. else
  332. xs ren $oldname *.BAK
  333. if ($oldname contains "[^:\\\\]*$")
  334. xs ren $tmpname $match
  335. else
  336. warning("Couldn't rename $tmpname to $oldname")
  337. endif
  338. endif
  339. endproc
  340. proc make_bak_to_bat($oldname,$tmpname,#bat)
  341. declare $left,$match,$right,#case
  342. declare $bak
  343. if ($oldname contains "\\.[^\\.\\\\]*$")
  344. $bak=$left.BAK
  345. else
  346. $bak=$oldname.BAK
  347. endif
  348. wr #bat,if exist $bak del $bak
  349. wr #bat,if exist $oldname ren $oldname *.bak
  350. if ($oldname contains "[^:\\\\]*$")
  351. wr #bat,if exist $tmpname ren $tmpname $match
  352. else
  353. warning("Couldn't rename $tmpname to $oldname")
  354. endif
  355. endproc
  356. strfunc ensure_dot($ext)
  357. if ($ext <> "")
  358. i